VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPathFinder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'====================================================================================
'clsPathFinder - Find the shortest route between point A & B
'====================================================================================
'NOTE: Please be careful when editing this page. This same module is used both in
'      the game and the level editor.

'A Dijkstra method is used to search the maze and produce the result. This is used
'instead of the faster A* method as Dijkstra can better handle the wrap-around effect
'of Pac Mar levels. This code has also been modified to handle maze data where the
'walls are specified as binary flags, 1, 2, 4, & 8 for North, East, South, West.

'Adapted from the work of Julien Lecomte
'webmaster@amanitamuscaria.org
'http://www.amanitamuscaria.org

Option Explicit

'A node in a tree of interlinked nodes of potential paths
Private Type PF_NODE
    Location As PM_XY       'The X/Y location in the maze
    Value As Long           'A node's depth in the chain
    Link As Long            'Index of another node this one is linked to in the chain
End Type

'A tree for the mapping and traversing of the maze
Private Type PF_NODETREE
    Node() As PF_NODE       'The list of nodes used in search
    Visited() As Long       'Which cells have already been visited in the search
    Count As Long           'Number of nodes in use
    Current As Long         'Current node in the chain under inspection
    FirstEmpty As Long      'Where to start looking from
End Type
Private Tree As PF_NODETREE

Private Enum CELL_STATUS
    CELL_EMPTY = -1         'An empty cell to be examined
    CELL_SOLID = -2         'An impassable wall
    CELL_MAX = 65535        'Max distance to search
End Enum

'Locations in the maze:
Private StartPoint As PM_XY        'Starting point (X, Y)
Private BehindYou As PM_DIRECTION  'Prevent going backwards from start-point
Private BackWall As PM_XY          'The cell behind the starting point
Private EndPoint As PM_XY          'The end point to reach

'A reference to the maze data
Private MyMaze As clsLevelData

'LET Maze: Set the maze to search through
'====================================================================================
Public Property Set Maze(ByRef NewMaze As clsLevelData)
    Set MyMaze = NewMaze
End Property

'====================================================================================
'FindPath: Work out shortest route from A to B
'====================================================================================
Public Function FindPath(ByVal StartX As Long, ByVal StartY As Long, ByVal EndX As Long, ByVal EndY As Long, Optional ByVal StartPointBlockDirection As PM_DIRECTION = 0) As Boolean
    'The Maze class property must be set before you can do anything else.
    'If the maze isn't going to change shape often, just set it when you initialise
    'the class, there's no need to set it every time you need to do a search
    If IsEmpty(MyMaze) Then
        Err.Raise 1, "clsPathFinder.FindPath", _
                     "A Maze has not been set."
    End If
    
    'Set search parameters
    Me.PrepareSearch StartX, StartY, EndX, EndY, StartPointBlockDirection
    
    'Traverse the tree until a final route has been found
    Do Until Tree.Current > Tree.Count Or FindPath
        If Tree.Node(Tree.Current).Value = CELL_EMPTY Then
            'This function returns True if successful path was found, False if not
            FindPath = Me.FindNextNode
        End If
        Tree.Current = Tree.Current + 1
    Loop
    
    'Reverse the chain backwards to produce the definite path that can then be
    'followed node by node easily
    Me.GenerateResultPath
End Function

'====================================================================================
'PrepareSearch: Reset any previous search and prepare for a new one
'====================================================================================
Public Sub PrepareSearch(StartX As Long, StartY As Long, EndX As Long, EndY As Long, Optional ByVal StartPointBlockDirection As PM_DIRECTION = 0)
    'The Maze class property must be set before you can do anything else.
    'If the maze isn't going to change shape often, just set it when you initialise
    'the class, there's no need to set it every time you need to do a search
    If IsEmpty(MyMaze) Then
        Err.Raise 1, "clsPathFinder.PrepareSearch", _
                     "A Maze has not been set."
    End If
    
    'The maximum nuber of nodes can only be the maximum number of cells in the maze
    ReDim Tree.Visited(MyMaze.Width - 1, MyMaze.Height - 1) As Long
    ReDim Tree.Node(1 To MyMaze.Width * MyMaze.Height) As PF_NODE
    
    'The start point will need to be referred to later for the "BehindYou" property,
    'description further down this function
    StartPoint.X = StartX
    StartPoint.Y = StartY
    EndPoint.X = EndX
    EndPoint.Y = EndY
    
    'Get the wall layout of the start point
    '(1 = Top, 2 = Right, 4 = Bottom, 8 = Left, added together)
    Dim Cell As Byte
    Cell = MyMaze.Tile(StartPoint.X, StartPoint.Y)
    
    '"BehindYou" allows you to specify a direction to block off on the starting cell
    'This is so that a path can be found that does not immediately about-face, if
    'the player is alrady going one direction and cannot change unless at a junction
    '(e.g. the ghosts in Pac Man). `BehindYou` is 1,2,4 or 8 as noted above
    BehindYou = StartPointBlockDirection
    If BehindYou > 0 Then
        'We also need to take note of the cell 'behind you', as when patching the
        'maze to add this wall, it has to be added on both sides. We start by moving
        'one cell in the right direction
        Dim Vec As PM_XY
        Vec = SharedMath.GetVectorFromDirection(BehindYou)
        BackWall.X = StartX + Vec.X
        BackWall.Y = StartY + Vec.Y
        'Wrap around if the adjacent cell is off the sides of the map
        If BackWall.X < 0 Then BackWall.X = (MyMaze.Width - 1)
        If BackWall.X >= MyMaze.Width Then BackWall.X = 0
        'Temporarily add in the wall behind you for use in this function
        Cell = AddBits(Cell, BehindYou)
    End If
    
    Tree.Count = 0
    Tree.Current = 1
    'Starting from the start point, look at the four surrounding cells and if any
    'are passable, add them to the list of places to start searching from
    p_AddNode StartX, StartY
    With Tree.Node(Tree.Current)
        .Value = 0
        If IfNotBits(Cell, PM_WALL_LEFT) Then p_AddNode .Location.X - 1, .Location.Y
        If IfNotBits(Cell, PM_WALL_TOP) Then p_AddNode .Location.X, .Location.Y - 1
        If IfNotBits(Cell, PM_WALL_RIGHT) Then p_AddNode .Location.X + 1, .Location.Y
        If IfNotBits(Cell, PM_WALL_BOTTOM) Then p_AddNode .Location.X, .Location.Y + 1
    End With
    
    'Start point is the reference for the search process
    Tree.Current = Tree.Current + 1
    Tree.FirstEmpty = Tree.Current
End Sub

'====================================================================================
'PRIVATE AddNode - Add a cell to branch off of in pursuit of the end point
'====================================================================================
Private Sub p_AddNode(ByVal X As Long, ByVal Y As Long)
    'Wrap around if outside the left or right side. This occurs when a search begins
    'on the edge of a maze, and the adjacent cells are added for checking
    If X < 0 Then X = (MyMaze.Width - 1)
    If X >= MyMaze.Width Then X = 0
    
    'If we've already seen this cell, don't add it
    If Tree.Visited(X, Y) = 0 Then
        'Check there are some exits in the cell.
        'Walls North (1) + East (2) + South (4) + West (8) = 15 (PM_WALL_ALL)
        If (MyMaze.Tile(X, Y) And PM_WALL_ALL) <> PM_WALL_ALL Then
            'Assign a new blank node:
            Tree.Count = Tree.Count + 1
            With Tree.Node(Tree.Count)
                .Location.X = X
                .Location.Y = Y
                .Value = CELL_EMPTY
                .Link = 0
            End With
            Tree.Visited(X, Y) = Tree.Count
        Else
            'If the cell is a solid wall, it's no use
            Tree.Visited(X, Y) = CELL_SOLID
        End If
    End If
End Sub

'====================================================================================
'FindNextNode: Step thorugh the search process
'====================================================================================
Public Function FindNextNode() As Boolean
    Dim Resistance As Long, LeastResistance As Long
    Dim Cell As Byte, X As Long, Y As Long
    Dim Index As Long
    
    LeastResistance = CELL_MAX
    
    With Tree.Node(Tree.Current)
        'Get the wall layout of the cell (1=Top + 2=Right + 4=Bottom + 8=Left)
        Cell = MyMaze.Tile(.Location.X, .Location.Y)
        'If the option to prevent going backwards at the start point is given...
        If BehindYou > 0 Then
            'If we're on the start point, add in the wall behind you
            If .Location.X = StartPoint.X And .Location.Y = StartPoint.Y Then
                Cell = AddBits(Cell, BehindYou)
            'And the wall on the other side to make it solid
            ElseIf .Location.X = BackWall.X And .Location.Y = BackWall.Y Then
                Cell = AddBits(Cell, GetReverseDirection(BehindYou))
            End If
        End If
        
        'Look at the adjacent cells in Left, Right, Up, Down order. You can't use a
        'normal type in a `For Each` so it's a variant here
        Dim Direction As Variant, Vector As PM_XY
        For Each Direction In Array(8, 2, 1, 4)
            'Is there a door in this direction?
            If IfNotBits(Cell, Direction) Then
                'Expand the direction into a vector, and step into the new cell
                Vector = SharedMath.GetVectorFromDirection(Direction)
                X = .Location.X + Vector.X: Y = .Location.Y + Vector.Y
                'Wrap around if you step off one side of the maze
                If X < 0 Then X = (MyMaze.Width - 1)
                If X >= MyMaze.Width Then X = 0
                'Don't fall off the top/bottom
                If Y >= 0 And Y < MyMaze.Height Then
                    'Have we been past this cell already?
                    Index = Tree.Visited(X, Y)
                    If Index = 0 Then
                        'Nope, add this cell to this list
                        p_AddNode X, Y
                        
                    ElseIf Index > 0 Then
                        'What distance (number of steps walked) is this cell from
                        'the start point?
                        Resistance = Tree.Node(Index).Value
                        If Resistance >= 0 Then
                            'If this direction leads to the path of least resistence
                            'then mark this as the new lowest to search against
                            If Resistance < LeastResistance Then
                                LeastResistance = Resistance
                                'Link this adjacent cell to the one we were just in
                                'So we can follow the chain back to the start when
                                'the shortest path has been found
                                .Link = Index
                            End If
                        End If
                    End If
                End If
            End If
        Next Direction
        
        'As you step further away from the start point, the cell value increases,
        'which is used to calculate the path of least resistance
        .Value = LeastResistance + 1
        
        'Return true if this node has reached the end
        FindNextNode = ((.Location.X = EndPoint.X) And (.Location.Y = EndPoint.Y))   'TRUE if we found the END
    End With
End Function

'====================================================================================
'GenerateResultsPath: After search is complete, follow the shortest path back
'====================================================================================
Public Function GenerateResultPath() As Long
    Dim NodeFrom As Long, NodeTo As Long, Piggy As Long '(In the middle)
    
    'This function follows the chain from the end, back to the start, reversing the
    'links so that the shortest path can easily be followed start to end
    
    'Was the end even reached?
    Piggy = Tree.Visited(EndPoint.X, EndPoint.Y)
    If Piggy Then Tree.Current = Piggy
    
    'Mark as the end (no link to any other cells)
    NodeTo = Tree.Current
    NodeFrom = Tree.Node(Tree.Current).Link
    Tree.Node(NodeTo).Link = 0
    
    If NodeFrom Then
        Do
            'Do a quick bit of jiggery-pokery to swap the direction of the link
            Piggy = Tree.Node(NodeFrom).Link
            Tree.Node(NodeFrom).Link = NodeTo
            NodeTo = NodeFrom
            NodeFrom = Piggy
            'Count the number of steps for the return value
            GenerateResultPath = GenerateResultPath + 1
            
        Loop Until NodeFrom = 0  'The start point will have no link as well
    End If
End Function

'====================================================================================
'NextEmptyNode: Steps through nodes until an empty cell is found
'====================================================================================
Public Function NextEmptyNode() As Boolean
    Dim K As Long
    
    For K = Tree.FirstEmpty To Tree.Count
        If Tree.Node(K).Value = CELL_EMPTY Then
            Tree.Current = K
            Tree.FirstEmpty = K
            Exit Function
        End If
    Next
    NextEmptyNode = True
End Function

'====================================================================================
'NextResultNode: Moves along the chain from one cell to the next
'====================================================================================
Public Function NextResultNode(ByRef X As Long, ByRef Y As Long) As Long
    Tree.Current = Tree.Node(Tree.Visited(X, Y)).Link
    If Tree.Current Then GetNode X, Y
    NextResultNode = Tree.Current
End Function

'====================================================================================
'GetNode: The X, Y in the maze of the current node
'====================================================================================
Public Function GetNode(ByRef X As Long, ByRef Y As Long)
    X = Tree.Node(Tree.Current).Location.X
    Y = Tree.Node(Tree.Current).Location.Y
End Function

'====================================================================================
'CLASS Terminate
'====================================================================================
Private Sub Class_Terminate()
    Erase Tree.Node
    Erase Tree.Visited
End Sub

'=== END ============================================================================
'This work is licenced under the Creative Commons Attribution 2.5 License
